home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok32.lha / TestBild / txt / Screen.mod < prev    next >
Text File  |  1993-08-15  |  4KB  |  130 lines
  1. (*--------------------------------------------------------------------------
  2.     :Program.      Menu.mod
  3.     :Author.       Andreas Lüdtke
  4.     :Address.      Stangestraße 11, D 2000 Hamburg 50
  5.     :Phone.        040/3905153
  6.     :History.      V1.0, 01-Jan-90, Andreas Lüdtke
  7.     :Copyright.    PD © Andreas Lüdtke 1990.
  8.     :Language.     Modula-2
  9.     :Translator.   M2Amiga 3.3d
  10.     :Contents.     Implementationsmodul zur Initialisierung des Screens
  11.     :Contents.     und des Windows des Testbildprogramms
  12.  ---------------------------------------------------------------------------*)
  13.  
  14. IMPLEMENTATION MODULE Screen;
  15.  
  16. FROM Arts               IMPORT Assert, TermProcedure;
  17. FROM SYSTEM             IMPORT ADR, ADDRESS;
  18. FROM Intuition          IMPORT WindowFlags, NewWindow, IDCMPFlags, IDCMPFlagSet,
  19.         WindowFlagSet, WindowPtr, ScreenPtr, customScreen, NewScreen,
  20.         OpenWindow, OpenScreen, IntuiText, IntuiTextPtr,
  21.         ScreenFlags, ScreenFlagSet, CloseScreen, CloseWindow;
  22. FROM Graphics           IMPORT SetRGB4, ViewModes, ViewModeSet, RastPortPtr,
  23.      jam2, ViewPortPtr, DrawModes, DrawModeSet, Move, Draw, SetAPen, RectFill,
  24.      WritePixel, TextAttrPtr;
  25.  
  26.  
  27. CONST
  28.   PLANES        = 4;  (* Anzahl Screen-Planes *)
  29.   Titel = "  Testbildgenerator V1.0 vom 01.01.90    handmade by A.Lüdtke";
  30.  
  31. VAR
  32.   Fenster       : NewWindow;
  33.   Schirm        : NewScreen;
  34.  
  35.  
  36. PROCEDURE SetColors( sp : ScreenPtr);
  37. VAR
  38.   vpptr : ViewPortPtr;
  39. BEGIN
  40.   vpptr := ADR(sp^.viewPort);
  41.   SetRGB4( vpptr,  0,  0,  0,  0);
  42.   SetRGB4( vpptr,  1, 15, 15, 15);
  43. (* Die Farbregister 2..9 werden durch andere Prozeduren gesetzt,siehe Menu *)
  44.   SetRGB4( vpptr, 10,  8,  6,  4);
  45.   SetRGB4( vpptr, 11,  3,  3,  3);
  46.   SetRGB4( vpptr, 12,  6,  6,  6);
  47.   SetRGB4( vpptr, 13, 10, 10, 10);
  48.   SetRGB4( vpptr, 14,  0,  0,  0);
  49.   SetRGB4( vpptr, 15, 15, 15, 15);
  50. END SetColors;
  51.  
  52.  
  53. PROCEDURE InitText( fP : INTEGER;
  54.                     bP : INTEGER;
  55.                     lE : INTEGER;
  56.                     tE : INTEGER;
  57.               VAR Text : IntuiText;
  58.                TextAdr : ADDRESS);
  59. BEGIN
  60.   WITH Text DO
  61.     frontPen    := fP;                  backPen         := bP;
  62.     drawMode    := jam2;                leftEdge        := lE;
  63.     topEdge     := tE;                  iTextFont       := NIL;
  64.     iText       := TextAdr;             nextText        := NIL;
  65.   END;
  66. END InitText;
  67.  
  68.  
  69. PROCEDURE OpenScreenAndWindow (VAR sp : ScreenPtr;
  70.                                VAR wp : WindowPtr;
  71.                               intlace : BOOLEAN);
  72. BEGIN
  73.   wp := NIL;
  74.   sp := NIL;
  75.   WITH Schirm DO
  76.     leftEdge    := 0;                   topEdge         := 0;
  77.     width       := 640;
  78.     IF intlace THEN
  79.       height    := 2*Hoehe;
  80.     ELSE
  81.       height    := Hoehe;
  82.     END;
  83.     depth       := PLANES;              detailPen       := 1;
  84.     blockPen    := 0;                   viewModes       := ViewModeSet{hires};
  85.     IF intlace THEN INCL(viewModes,lace) END;
  86.     type        := customScreen + ScreenFlagSet{screenBehind};
  87.     font        := NIL;                 defaultTitle    := ADR(Titel);
  88.     gadgets     := NIL;                 customBitMap    := NIL
  89.   END;
  90.   sp := OpenScreen( Schirm );
  91.   Assert(sp#NIL,ADR("Testbild: Screen konnte nicht geöffnet werden"));
  92.   SetColors( sp);
  93.   WITH Fenster DO
  94.     leftEdge    := 0;                   topEdge         := 0;
  95.     width       := Breite;              title           := NIL;
  96.     IF intlace THEN
  97.       height    := 2*Hoehe;
  98.     ELSE
  99.       height    := Hoehe;
  100.     END;
  101.     detailPen   := 0;                   blockPen        := 1;
  102.     flags       := WindowFlagSet{ activate, borderless, backDrop};
  103.     idcmpFlags  := IDCMPFlagSet { menuPick};
  104.     type        := customScreen;        checkMark       := NIL;
  105.     firstGadget := NIL;                 screen          := sp;
  106.     bitMap      := NIL;                 minWidth        := 0;
  107.     minHeight   := 0;                   maxWidth        := 0;
  108.     maxHeight   := 0;
  109.   END;
  110.   wp := OpenWindow( Fenster);
  111.   Assert(wp#NIL,ADR("Testbild: Kein Platz für Fenster"));
  112. END OpenScreenAndWindow;
  113.  
  114.  
  115. PROCEDURE CloseScreenAndWindow (VAR sp : ScreenPtr;
  116.                                 VAR wp : WindowPtr);
  117. BEGIN
  118.   IF wp # NIL THEN
  119.     CloseWindow( wp);
  120.     wp := NIL;
  121.   END;
  122.   IF sp # NIL THEN
  123.     CloseScreen( sp);
  124.     sp := NIL;
  125.   END;
  126. END CloseScreenAndWindow;
  127.  
  128.  
  129. END Screen.mod
  130.